home *** CD-ROM | disk | FTP | other *** search
/ PC User 2003 January / Disc 3 / Amethyst.iso / live / lisa / usr / lib / rpm-3.0.6 / mklists.pl < prev    next >
Encoding:
Perl Script  |  2001-01-05  |  7.0 KB  |  268 lines
  1. #!/usr/bin/perl -w
  2. # $Id: mklists.pl,v 1.8 2000/07/04 08:20:14 ray Exp $
  3. #use strict;
  4.  
  5. my $C = $0; $C =~ s%.*/%%;
  6.  
  7. my $Mode = "create";
  8. my $Append = "";
  9. my $Help = 0;
  10. my $OptErr = "";
  11. my $debug = 0;
  12. my $missed = "MISSED";
  13. my %noMatch = ();        # remember all patterns without a match
  14. my $quoteE = "";
  15. my $asterE = "";
  16. my $RetVal = 0;
  17.  
  18. my %Default =
  19.    ( 
  20.     "dirs",
  21.     [[ q:^/(bin|dev|etc|lib|sbin|usr|var)/$:,        "IGNORED"],
  22.      [ q:^/usr/(bin|doc|etc|games|include|info)/$:,    "IGNORED"],
  23.      [ q:^/usr/(lib|man|sbin|share|src)/$:,        "IGNORED"],
  24.      [ q:^/usr/share/(man|locale)/:,            "IGNORED"],
  25.      [ q:^/usr/share/(info|doc)/$:,            "IGNORED"],
  26.      [ q:^/var/(lib|lock|log|run|spool|state|tmp)/$:,    "IGNORED"],
  27.      [ q:^/usr/X11R6/:,                    "IGNORED"],
  28.      [ q:^/opt/kde/:,                    "IGNORED"],
  29.      # pre-LSB rules
  30.      [ q:^/usr/man/man[123456789n]/$:,            "IGNORED"],
  31.      [ q:.*:,                        "base"],
  32.     ],
  33.     "files",
  34.     [#[ q:/share/(locale|man)/(?>(?!(de|en|es|fr|it)/)):,    "l10n"],
  35.      [ q:/man[1456789n]/:,                "base"],
  36.      [ q:/man[23]/:,                     "devel"],
  37.      [ q:^/usr/include:,                 "devel"],
  38.      [ q:^(/usr)?/lib/.*\.so$:,             "devel"],
  39.      [ q:^(/usr)?/lib/.*\.a$:,                "devel-static"],
  40.      [ q:^\s*$:,                    "IGNORED"],
  41.      [ q:^\#:,                        "IGNORED"],
  42.      [ q:.*:,                        "base"],
  43.     ]
  44. );
  45.  
  46. ### functions
  47. sub compilePattern($@) {
  48.   my( $mode, @default) = @_;
  49.   my( @p2p) = ();
  50.   my( $defattr) = "";
  51.  
  52.   if ( $Mode eq "dirs" ) {
  53.     $Prefix = "%dir ";
  54.   } else {
  55.     $Prefix = "";
  56.   }
  57.  
  58.   unshift(@ARGV, '-') if $#ARGV < $[;
  59.   while ( <> ) {
  60.     next if ( m:^\s*$: || m:^\s*\#: );
  61.     print( STDERR "processing") if ( $debug );
  62.     if ( s/^\*\s+\*\s+//o || s/^\@defattr\@\s*//io ) {
  63.       # handle special line: set default attributes
  64.       chomp($defattr = $_);
  65.     } elsif ( s/^\*\s+(\S+)\s*$/$1/ || s/^\@(default).*$/$1/ ) {
  66.       my $set = $1;
  67.       die( "Sorry! Only 'default' supported for now!\n")
  68.     unless ( $set eq "default" );
  69.       print( STDERR " ruleset: '$set' ") if ( $debug );
  70.       for ( $i = 0 ; $i <= $#default ; $i ++ ) {
  71.     print( STDERR ".") if ( $debug );
  72.     push( @p2p, [ @{$default[$i]} ]);
  73.       }
  74.       print( STDERR "\n") if ( $debug );
  75.     } else {
  76.       print( STDERR " rule...\n") if ( $debug );
  77.  
  78.       # split the pattern line:
  79.       #   first <pattern>,
  80.       #   second <target>,
  81.       #   third optional attributes
  82.       my ( $patt, $targ, $attr) = split(' ', $_, 3);
  83.       my $prefix = "";
  84.  
  85.       if ( $attr or $defattr) {
  86.     my ( @attr) = ( split(/\s*,\s*/, $defattr), split(/\s*,\s*/, $attr) );
  87.  
  88.     foreach (@attr) {
  89.       if ( m/prefix\((.*)\)/o) {
  90.         if ($1) { $prefix .= " $1" } else { $prefix = "" };
  91.         print( STDERR "prefix for '$patt' matches is '$prefix'\n")
  92.           if ( $debug );
  93.       } elsif ( m/mandatory/o) {
  94.         print( STDERR "'$patt' is mandatory to match\n")
  95.           if ( $debug );
  96.         $noMatch{$patt} = 1;
  97.       } elsif ( m/\!/o) {
  98.         if ( defined( $noMatch{$patt}) ) {
  99.           delete( $noMatch{$patt});
  100.           print( STDERR "'$patt' is NOT mandatory to match\n")
  101.         if ( $debug );
  102.         } else {
  103.           $noMatch{$patt} = 1;
  104.           print( STDERR "'$patt' is mandatory to match\n")
  105.         if ( $debug );
  106.         }
  107.       } else {
  108.         print( STDERR "'$_' is not a known attribute, ignored\n")
  109.           if ( $debug );
  110.       }
  111.     }
  112.     $prefix =~ s/^ //;
  113.       }      
  114.       push( @p2p, [ $patt, $targ, $prefix ]);
  115.     }    
  116.   }
  117.   # catch the rest...
  118.   push( @p2p,     [ ".*", $missed]);
  119.  
  120.   return ( @p2p );
  121. }
  122.  
  123. sub listSubs(@) {
  124.   my( @f ) = @_;
  125.   my( %s) = ();
  126.   my( $i, $j) = ( "", "");
  127.   my( @b) = ();
  128.  
  129.   for $i ( 0 .. $#f ) {
  130.     printf( STDERR "pkg='%s' pattern='%s'\n", $f[$i][1], $f[$i][0])
  131.        if ( $debug );
  132.     $s{$f[$i][1]} ++;
  133.   }
  134.  
  135.   foreach $i ( sort( keys( %s)) ) {
  136.     printf( STDERR "sub='%s': %d\n", $i, $s{$i}) if ( $debug >= 2 );
  137.     next unless ( defined( $s{$i}) && $s{$i} > 0 );
  138.     push( @b, $i) unless ( $i eq $j );
  139.     $j = $i;
  140.   }
  141.   printf( STDERR "subs: '%s'\n", join( ', ', @b)) if ( $debug >= 1 );
  142.   return ( @b );
  143. }
  144.  
  145. sub match(\$) {
  146.   my ( $t) = @_;
  147.   my ( $i) = 0;
  148.   my ( $patt, $out, $pref ) = undef;
  149.   my $mc = 0;
  150.  
  151.   for ( $i=0; $i <= $#f2p ; $i++ ) {
  152.     ( $patt, $out, $pref ) = @{$f2p[$i]};
  153.     printf( STDERR "testing(%d): '%s'\n", $i, $patt) if ( $debug >= 9 );
  154.     if ( $$t =~ m:$patt: ) {
  155.       $mc ++;
  156.       delete $noMatch{$patt} if ( defined( $noMatch{$patt}) );
  157.       if ( $mc == 1 && $$t =~ /[ \t]/ ) {
  158.     chomp( $$t);
  159.     if ( $$t =~ /\*/ ) {
  160.       $asterE .= "  '$$t'\n";
  161.     }
  162.     if ( $$t =~ /\"/ ) {
  163.       # rpm botches on those...
  164.       $quoteE .= "  '$$t'\n";
  165.       next;
  166.     }
  167.     $$t = "\"" . $$t . "\"\n" if ( $$t =~ m:^/: );
  168.       }
  169.       $$t = "$pref $$t" if ( $pref );
  170.       # continue the search for matching patterns for special queue '*'
  171.       return $out unless ( $out eq '*' );
  172.     }
  173.   }
  174.   
  175.   printf( STDERR "Ouch: undefined: \$f2p[$i]\n") ;
  176.   return( $missed );
  177. }
  178.  
  179. ### parameter check
  180. while ( $#ARGV >= $[ && ($_ = shift, /^-/ || (unshift(@ARGV,$_) && 0)) ) {
  181.   last if /^--$/;
  182.   (/^--create$/ || /^-c$/)        && ($Mode = "create", next);
  183.   (/^--dirs$/ || /^-d$/)        && ($Mode = "dirs", next);
  184.   (/^--files$/ || /^-f$/)        && ($Mode = "files", next);
  185.   (/^--append$/ || /^-a$/)        && ($Append = ">", next);
  186.   (/^--debug$/ || /^-D$/)        && ($debug ++, next);
  187.   (/^--?help/ || /^-h/)            && ($Help = 1, next);
  188.   (/^-/)                && ($OptErr .= "$_ ", next);
  189. }
  190.  
  191. if ( $OptErr ) {
  192.   printf( STDERR "$C: unkown option: $OptErr\n");
  193. }
  194.  
  195. my $Pkg = shift;
  196.  
  197.  
  198. if ( $OptErr || $Help ) {
  199.   die( "Usage: $C [-acdfh] pkg-name\n");
  200. }
  201.  
  202. if ( "$Mode" eq "create" ) {
  203.   my $D = $ENV{DESTDIR} || die( "$C: DESTDIR: no variable\n");
  204.   system( "rm -f dirs-$Pkg files-$Pkg files-$Pkg-*" ) &&
  205.      die( "$C: removing: $!\n");
  206.   system( "find $D -type d -mindepth 1 -printf '\"/%P/\"\n' | sort > dirs-$Pkg") &&
  207.      die( "$C: find dirs: $!\n");
  208.   system( "find $D -not -type d -printf '\"/%P\"\n' | sort > files-$Pkg")
  209. &&
  210.      die( "$C: find files: $!\n");
  211.   exit( 0);
  212. }
  213.  
  214. if ( ! -r "$Mode-$Pkg" ) {
  215.   die( "$C: $Mode-$Pkg: $!\n");
  216. }
  217.  
  218. my $i;
  219. local @f2p = compilePattern($Mode, @{$Default{$Mode}});
  220. my @subs = listSubs( @f2p);
  221.  
  222. open( IN, "< $Mode-$Pkg" ) || die( "open('$Pkg'): $!\n");
  223. foreach $i ( @subs ) {
  224.   printf( STDERR "open: >$Append files-$Pkg-$i\n") if ( $debug >= 2 );
  225.   open( $i, ">$Append files-$Pkg-$i") || die( "open('$Pkg-$i'): $!\n");
  226. }
  227.  
  228. while ( <IN> ) {
  229.   my $out = match( $_);
  230.   printf( STDERR "%-20s %s", "$out:", $_) if ( $debug >= 6 );
  231.   print( $out $Prefix . $_);
  232. }
  233. close( IN);
  234.  
  235. foreach $i ( @subs ) {
  236.   close( $i);
  237.   if ( -z "files-$Pkg-$i" ) {
  238.     printf( STDERR "removing empty '%s'\n", "files-$Pkg-$i")
  239.        if ( $debug >= 1 );
  240.     unlink( "files-$Pkg-$i");
  241.   }
  242. }
  243.  
  244. if ( $asterE ) {
  245.   print( STDERR "$C: warning: combination of whitespaces and '*' means" .
  246.      " trouble:\n" . $asterE);
  247. }
  248. if ( $quoteE ) {
  249.   print( STDERR "$C: Error: illegal combination of whitespace and ".
  250.      "'\"':\n" . $quoteE);
  251.   $RetVal++;
  252. }
  253. if ( %noMatch ) {
  254.   print( STDERR "$C: Error: following manadatory patterns did not match:\n");
  255.   foreach ( sort( keys( %noMatch)) ) {
  256.     printf( STDERR "    '%s'\n", $_ );
  257.   }
  258.   $RetVal++;
  259. }
  260. if ( -r "files-$Pkg-$missed" ) {
  261.   printf( STDERR "$C: Error: non-empty safety net: files-$Pkg-$missed\n");
  262.   $RetVal++;
  263.   exit( 1);
  264. }
  265.  
  266. exit( $RetVal);
  267.  
  268.